home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / HTML / Code / AppServer / svrPageHandler.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-10-26  |  2.8 KB  |  111 lines
  1. unit svrPageHandler;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, mleSMLContainer, mleCommon, UHTTPApp;
  7.  
  8. type
  9.   TPageHandler = class(TComponent)
  10.   protected
  11.     PageProducer: TUSPageProducer;    { component to parse template }
  12.     SMLContainer: TSMLContainer;      { Resolver for a block of SML tags }
  13.     procedure OnScriptingBlock(aSender: TObject; aBody: string; var aReplaceText: string);
  14.     function GetSMLScripts: string;
  15.     function GetSMLVars: string;
  16.     procedure LoadPageTemplate(aPageName: string);
  17.     function ResolveSML(aSML: string): string;
  18.   public
  19.     constructor Create(aOwner: TComponent; aPacket: TInfoPacket); reintroduce; virtual;
  20.     destructor Destroy; override;
  21.     function GetContent: string;
  22.   end;
  23.  
  24. implementation
  25.  
  26. uses
  27.   SysUtils, svrMain;
  28.  
  29. { TPageHandler }
  30.  
  31. constructor TPageHandler.Create(aOwner: TComponent; aPacket: TInfoPacket);
  32. begin
  33.   inherited Create(aOwner);
  34.   PageProducer := TUSPageProducer.Create(Self);
  35.   PageProducer.OnScriptingBlock := OnScriptingBlock;
  36.   SMLContainer := TSMLContainer.Create(aPacket);
  37. end;
  38.  
  39. destructor TPageHandler.Destroy;
  40. begin
  41.   SMLContainer.Free;
  42.   inherited;
  43. end;
  44.  
  45. function TPageHandler.GetContent: string;
  46. begin
  47.   LoadPageTemplate(SMLContainer.Variables.Values['PI:PAGE']);
  48.   Result := PageProducer.Content;
  49.   Result := StringReplace(Result, '<SMLVars>', GetSMLVars, [rfIgnoreCase]);
  50.   Result := StringReplace(Result, '<SMLScripts>', GetSMLScripts, [rfIgnoreCase]);
  51. end;
  52.  
  53. function TPageHandler.GetSMLScripts: string;
  54. var
  55.   I: Integer;
  56.   List: TStringList;
  57. begin
  58.   List := TStringList.Create;
  59.   try
  60.     List.Add('<SCRIPT>');
  61.     with SMLContainer.Scripts do
  62.       for I := 0 to Count - 1 do
  63.         List.Add(Values[Names[I]]);
  64.     List.Add('');
  65.     List.Add('</SCRIPT>');
  66.     Result := List.Text;
  67.   finally
  68.     List.Free;
  69.   end;
  70. end;
  71.  
  72. function TPageHandler.GetSMLVars: string;
  73. var
  74.   S: string;
  75. begin
  76.   Result := '';
  77.   S := SMLContainer.DataBindings.GetAsXML;
  78.   if S <> '' then
  79.     Result := Result + #13#10 +
  80.               '<INPUT type=hidden name=SMLDataBindings value=''' + S + '''>';
  81. end;
  82.  
  83. procedure TPageHandler.LoadPageTemplate(aPageName: string);
  84. var
  85.   Filename: string;
  86. begin
  87.   Filename := ExpandFileName(frmMain.edtTemplatePath.Text + aPageName);
  88.   if not FileExists(Filename) then
  89.     raise Exception.CreateFmt('File does not exist: %s', [Filename]);
  90.   PageProducer.HTMLFile := Filename;
  91. end;
  92.  
  93. procedure TPageHandler.OnScriptingBlock(aSender: TObject; aBody: string;
  94.   var aReplaceText: string);
  95. begin
  96.   aReplaceText := ResolveSML(aBody);
  97. end;
  98.  
  99. function TPageHandler.ResolveSML(aSML: string): string;
  100. begin
  101.   Result := '';
  102.   with SMLContainer do
  103.   begin
  104.     SML := '<SML>' + aSML + '</SML>';
  105.     Resolve;
  106.     Result := Trim(HTML.Text);
  107.   end;
  108. end;
  109.  
  110. end.
  111.